home *** CD-ROM | disk | FTP | other *** search
/ PC User 2003 January / Disc 3 / Amethyst.iso / live / usr / lib / rpm-3.0.6 / mklists.pl < prev    next >
Encoding:
Perl Script  |  2001-04-06  |  7.4 KB  |  277 lines
  1. #!/usr/bin/perl -w
  2. # $Id: mklists.pl,v 1.10 2000/12/14 13:09:57 ray Exp $
  3. #use strict;
  4.  
  5. my $C = $0; $C =~ s%.*/%%;
  6.  
  7. my $Mode = "create";
  8. my $Append = "";
  9. my $Help = 0;
  10. my $OptErr = "";
  11. my $debug = 0;
  12. my $missed = "MISSED";
  13. my %noMatch = ();        # remember all patterns without a match
  14. my $quoteE = "";
  15. my $asterE = "";
  16. my $RetVal = 0;
  17.  
  18. my %Default =
  19.    ( 
  20.     "dirs",
  21.     [[ q:^\"/(bin|dev|etc|lib|sbin|usr|var)/\"$:,    "IGNORED"],
  22.      [ q:^\"/usr/(bin|doc|etc|games|include|info)/\"$:,    "IGNORED"],
  23.      [ q:^\"/usr/(lib|man|sbin|share|src)/\"$:,        "IGNORED"],
  24.      [ q:^\"/usr/share/(man|locale)/:,            "IGNORED"],
  25.      [ q:^\"/usr/share/(info|doc)/\"$:,            "IGNORED"],
  26.      [ q:^\"/var/(lib|lock|log|run|spool|state|tmp)/\"$:, "IGNORED"],
  27.      [ q:^\"/usr/X11R6/:,                 "IGNORED"],
  28.      [ q:^\"/opt/kde/:,                    "IGNORED"],
  29.      # macro-based LSB/FHS directories
  30.      [ q:^\"@Cprefix@/\"$:,                "IGNORED"],
  31.      [ q:^\"@LRdir@/\"$:,                      "IGNORED"],
  32.      [ q:^\"@NKinetdir@/\"$:,                "IGNORED"],
  33.      [ q:^\"@SVIcdir@/\"$:,                 "IGNORED"],
  34.      [ q:^\"@SVIdir@/\"$:,                "IGNORED"],
  35.      [ q:^\"@SVIrcd@/\"$:,                "IGNORED"],
  36.      # pre-LSB rules
  37.      [ q:^\"/usr/man/man[123456789n]/\"$:,        "IGNORED"],
  38.      [ q:^\"/usr/include/:,                "devel"],
  39.      [ q:.*:,                        "base"],
  40.     ],
  41.     "files",
  42.     [#[ q:/share/(locale|man)/(?>(?!(de|en|es|fr|it)/)):,    "l10n"],
  43.      [ q:/man[1456789n]/:,                "base"],
  44.      [ q:/man[23]/:,                     "devel"],
  45.      [ q:^\"/usr/include:,                 "devel"],
  46.      [ q:^\"(/usr)?/lib/.*\.so\"$:,             "devel"],
  47.      [ q:^\"(/usr)?/lib/.*\.la\"$:,             "devel"],
  48.      [ q:^\"(/usr)?/lib/.*\.a\"$:,            "devel-static"],
  49.      [ q:^\"\s*\"$:,                    "IGNORED"],
  50.      [ q:^\"\#:,                    "IGNORED"],
  51.      [ q:.*:,                        "base"],
  52.     ]
  53. );
  54.  
  55. ### functions
  56. sub compilePattern($@) {
  57.   my( $mode, @default) = @_;
  58.   my( @p2p) = ();
  59.   my( $defattr) = "";
  60.  
  61.   if ( $Mode eq "dirs" ) {
  62.     $Prefix = "%dir ";
  63.   } else {
  64.     $Prefix = "";
  65.   }
  66.  
  67.   unshift(@ARGV, '-') if $#ARGV < $[;
  68.   while ( <> ) {
  69.     next if ( m:^\s*$: || m:^\s*\#: );
  70.     print( STDERR "processing") if ( $debug );
  71.     if ( s/^\*\s+\*\s+//o || s/^\@defattr\@\s*//io ) {
  72.       # handle special line: set default attributes
  73.       chomp($defattr = $_);
  74.     } elsif ( s/^\*\s+(\S+)\s*$/$1/ || s/^\@(default).*$/$1/ ) {
  75.       my $set = $1;
  76.       die( "Sorry! Only 'default' supported for now!\n")
  77.     unless ( $set eq "default" );
  78.       print( STDERR " ruleset: '$set' ") if ( $debug );
  79.       for ( $i = 0 ; $i <= $#default ; $i ++ ) {
  80.     print( STDERR ".") if ( $debug );
  81.     push( @p2p, [ @{$default[$i]} ]);
  82.       }
  83.       print( STDERR "\n") if ( $debug );
  84.     } else {
  85.       print( STDERR " rule...\n") if ( $debug );
  86.  
  87.       # split the pattern line:
  88.       #   first <pattern>,
  89.       #   second <target>,
  90.       #   third optional attributes
  91.       my ( $patt, $targ, $attr) = split(' ', $_, 3);
  92.       my $prefix = "";
  93.  
  94.       if ( $attr or $defattr) {
  95.     my ( @attr) = ( split(/\s*,\s*/, $defattr), split(/\s*,\s*/, $attr) );
  96.  
  97.     foreach (@attr) {
  98.       if ( m/prefix\((.*)\)/o) {
  99.         if ($1) { $prefix .= " $1" } else { $prefix = "" };
  100.         print( STDERR "prefix for '$patt' matches is '$prefix'\n")
  101.           if ( $debug );
  102.       } elsif ( m/mandatory/o) {
  103.         print( STDERR "'$patt' is mandatory to match\n")
  104.           if ( $debug );
  105.         $noMatch{$patt} = 1;
  106.       } elsif ( m/\!/o) {
  107.         if ( defined( $noMatch{$patt}) ) {
  108.           delete( $noMatch{$patt});
  109.           print( STDERR "'$patt' is NOT mandatory to match\n")
  110.         if ( $debug );
  111.         } else {
  112.           $noMatch{$patt} = 1;
  113.           print( STDERR "'$patt' is mandatory to match\n")
  114.         if ( $debug );
  115.         }
  116.       } else {
  117.         print( STDERR "'$_' is not a known attribute, ignored\n")
  118.           if ( $debug );
  119.       }
  120.     }
  121.     $prefix =~ s/^ //;
  122.       }      
  123.       push( @p2p, [ $patt, $targ, $prefix ]);
  124.     }    
  125.   }
  126.   # catch the rest...
  127.   push( @p2p,     [ ".*", $missed]);
  128.  
  129.   return ( @p2p );
  130. }
  131.  
  132. sub listSubs(@) {
  133.   my( @f ) = @_;
  134.   my( %s) = ();
  135.   my( $i, $j) = ( "", "");
  136.   my( @b) = ();
  137.  
  138.   for $i ( 0 .. $#f ) {
  139.     printf( STDERR "pkg='%s' pattern='%s'\n", $f[$i][1], $f[$i][0])
  140.        if ( $debug );
  141.     $s{$f[$i][1]} ++;
  142.   }
  143.  
  144.   foreach $i ( sort( keys( %s)) ) {
  145.     printf( STDERR "sub='%s': %d\n", $i, $s{$i}) if ( $debug >= 2 );
  146.     next unless ( defined( $s{$i}) && $s{$i} > 0 );
  147.     push( @b, $i) unless ( $i eq $j );
  148.     $j = $i;
  149.   }
  150.   printf( STDERR "subs: '%s'\n", join( ', ', @b)) if ( $debug >= 1 );
  151.   return ( @b );
  152. }
  153.  
  154. sub match(\$) {
  155.   my ( $t) = @_;
  156.   my ( $i) = 0;
  157.   my ( $patt, $out, $pref ) = undef;
  158.   my $mc = 0;
  159.  
  160.   for ( $i=0; $i <= $#f2p ; $i++ ) {
  161.     ( $patt, $out, $pref ) = @{$f2p[$i]};
  162.     printf( STDERR "testing(%d): '%s'\n", $i, $patt) if ( $debug >= 9 );
  163.     if ( $$t =~ m:$patt: ) {
  164.       $mc ++;
  165.       delete $noMatch{$patt} if ( defined( $noMatch{$patt}) );
  166.       if ( $mc == 1 && $$t =~ /[ \t]/ ) {
  167.     chomp( $$t);
  168.     if ( $$t =~ /\*/ ) {
  169.       $asterE .= "  '$$t'\n";
  170.     }
  171.     if ( $$t =~ /\"/ ) {
  172.       # rpm botches on those...
  173.       $quoteE .= "  '$$t'\n";
  174.       next;
  175.     }
  176.     $$t = "\"" . $$t . "\"\n" if ( $$t =~ m:^/: );
  177.       }
  178.       $$t = "$pref $$t" if ( $pref );
  179.       # continue the search for matching patterns for special queue '*'
  180.       return $out unless ( $out eq '*' );
  181.     }
  182.   }
  183.   
  184.   printf( STDERR "Ouch: undefined: \$f2p[$i]\n") ;
  185.   return( $missed );
  186. }
  187.  
  188. ### parameter check
  189. while ( $#ARGV >= $[ && ($_ = shift, /^-/ || (unshift(@ARGV,$_) && 0)) ) {
  190.   last if /^--$/;
  191.   (/^--create$/ || /^-c$/)        && ($Mode = "create", next);
  192.   (/^--dirs$/ || /^-d$/)        && ($Mode = "dirs", next);
  193.   (/^--files$/ || /^-f$/)        && ($Mode = "files", next);
  194.   (/^--append$/ || /^-a$/)        && ($Append = ">", next);
  195.   (/^--debug$/ || /^-D$/)        && ($debug ++, next);
  196.   (/^--?help/ || /^-h/)            && ($Help = 1, next);
  197.   (/^-/)                && ($OptErr .= "$_ ", next);
  198. }
  199.  
  200. if ( $OptErr ) {
  201.   printf( STDERR "$C: unkown option: $OptErr\n");
  202. }
  203.  
  204. my $Pkg = shift;
  205.  
  206.  
  207. if ( $OptErr || $Help ) {
  208.   die( "Usage: $C [-acdfh] pkg-name\n");
  209. }
  210.  
  211. if ( "$Mode" eq "create" ) {
  212.   my $D = $ENV{DESTDIR} || die( "$C: DESTDIR: no variable\n");
  213.   system( "rm -f dirs-$Pkg files-$Pkg files-$Pkg-*" ) &&
  214.      die( "$C: removing: $!\n");
  215.   system( "find $D -type d -mindepth 1 -printf '\"/%P/\"\n' | sort > dirs-$Pkg") &&
  216.      die( "$C: find dirs: $!\n");
  217.   system( "find $D -not -type d -printf '\"/%P\"\n' | sort > files-$Pkg")
  218. &&
  219.      die( "$C: find files: $!\n");
  220.   exit( 0);
  221. }
  222.  
  223. if ( ! -r "$Mode-$Pkg" ) {
  224.   die( "$C: $Mode-$Pkg: $!\n");
  225. }
  226.  
  227. my $i;
  228. local @f2p = compilePattern($Mode, @{$Default{$Mode}});
  229. my @subs = listSubs( @f2p);
  230.  
  231. open( IN, "< $Mode-$Pkg" ) || die( "open('$Pkg'): $!\n");
  232. foreach $i ( @subs ) {
  233.   printf( STDERR "open: >$Append files-$Pkg-$i\n") if ( $debug >= 2 );
  234.   open( $i, ">$Append files-$Pkg-$i") || die( "open('$Pkg-$i'): $!\n");
  235. }
  236.  
  237. while ( <IN> ) {
  238.   my $out = match( $_);
  239.   printf( STDERR "%-20s %s", "$out:", $_) if ( $debug >= 6 );
  240.   print( $out $Prefix . $_);
  241. }
  242. close( IN);
  243.  
  244. foreach $i ( @subs ) {
  245.   close( $i);
  246.   if ( -z "files-$Pkg-$i" ) {
  247.     printf( STDERR "removing empty '%s'\n", "files-$Pkg-$i")
  248.        if ( $debug >= 1 );
  249.     unlink( "files-$Pkg-$i");
  250.   }
  251. }
  252.  
  253. if ( $asterE ) {
  254.   print( STDERR "$C: warning: combination of whitespaces and '*' means" .
  255.      " trouble:\n" . $asterE);
  256. }
  257. if ( $quoteE ) {
  258.   print( STDERR "$C: Error: illegal combination of whitespace and ".
  259.      "'\"':\n" . $quoteE);
  260.   $RetVal++;
  261. }
  262. if ( %noMatch ) {
  263.   print( STDERR "$C: Error: following manadatory patterns did not match:\n");
  264.   foreach ( sort( keys( %noMatch)) ) {
  265.     printf( STDERR "    '%s'\n", $_ );
  266.   }
  267.   $RetVal++;
  268. }
  269. if ( -r "files-$Pkg-$missed" ) {
  270.   printf( STDERR "$C: Error: non-empty safety net: files-$Pkg-$missed\n");
  271.   $RetVal++;
  272.   exit( 1);
  273. }
  274.  
  275. exit( $RetVal);
  276.  
  277.